Software of the Month Cl… (Business) 1997 November/Software of the Month Club - Business Shareware (Volume 243) (November 1997).iso/dos/biz/Parse/EXAMPL21.POM

Text File | 1997-08-27 | 10.0 KB | 359 lines

;==============================================================================
;
;  Prologue
;
;------------------------------------------------------------------------------

PROLOGUE

  ;============================================================================
  ;
  ;   Initialization
  ;
  ;----------------------------------------------------------------------------
  ;
  ;   Handy Constants
  ;   ---------------
  ;
  SET      ALL          = "A"
  SET      BOTH         = "B"
  SET      COMMA        = ","
  SET      DASH         = "-"
  SET      DIGITS       = "0123456789"
  SET      FIRST        = ""
  SET      LAST         = ""
  SET      LASTSPACE    = ">* "
  SET      LEFT         = "L"
  SET      NO           = "N"
  SET      NULL         = ""
  SET      POSNANY      = ""
  SET      POSNLAST     = ">"
  SET      POSNFIRST    = "<"
  SET      RIGHT        = "R"
  SET      SPACE        = " "
  SET      YES          = "Y"
  ;
  ;   Initialize Input Trackers
  ;   -------------------------
  ;
  SET      AddrCount  = "0"

  ;============================================================================
  ;
  ;   Scanlists
  ;
  ;----------------------------------------------------------------------------
  ;
  ;   States
  ;   ------
  ;
  SET      STATES       = "/AB/AK/AL/AR/AZ/BC/CA/CO/CT/DC/DE/FL/GA/HI/IA/ID/IL/IN/KS/KY/LA/MA/MB/MD/ME/MI/MN/MO/MS/MT/NB/NC/ND/NE/NF/NH/NJ/NM/NS/NV/NY/OH/OK/ON/OR/PA/PR/QC/RI/SC/SD/SK/TN/TX/UT/VA/VT/WA/WI/WV/WY"

  ;============================================================================
  ;
  ;   Array Scanlists
  ;
  ;----------------------------------------------------------------------------
  ;
  ;   About Arrays of ScanLists
  ;
  ;     These arrays can be expanded by adding another scanlist with the next
  ;     number (e.g. after XYZ,5 you would add XYZ,6).
  ;
  ;     Each scanterm must be preceded by the same character that appears in
  ;     the first position of the scanlist (usually a slash).  You should put
  ;     the most obvious items first.  Try to put VERY obvious items in the
  ;     first scanlist.
  ;
  ;     No POM file line can extend beyond the 255th character.
  ;
  ;   Salutation Prefixes
  ;   -------------------
  ;
  SET      SALUTATN,1   = "/MR/MISS /MS/MRS/DR /DR./REVEREND /REV /REV."
  SET      SALUTATN,2   = "/SIR /DAME /LADY /HRH /THE RIGHT/THE HONORABLE"
  SET      SALUTATN,3   = "/MAJOR /MAJOR-GENERAL/MJR-/LT /LT./LT-/SARGEANT"
  SET      SALUTATN,4   = "/CPL /CPL./CORPORAL /GENERAL/GNL./OFFICER/OFF."
  SET      SALUTATN,5   = "/CAPTAIN/CPTN/CPTN./CPT/CPT."
  ;
  ;   Name Suffixes
  ;   -------------
  ;
  SET      NAMESUFF,1   = "/ SR./ JR./ SR/ JR/ II/ III/ IV/ V/ VI"
  SET      NAMESUFF,2   = "/ SENIOR/ JUNIOR/ CPA/ MD/ M.D./ PHD"
  SET      NAMESUFF,3   = "/ FSC/ F.S.C./ MBA/ M.B.A."

END

;==============================================================================
;
;  Mainline Code
;
;------------------------------------------------------------------------------
;
;   Count this record
;
SET      AddrCount    = AddrCount+
;
;   Get fields
;
SET      Name         = $FLUPC[  1  23]
SET      Title        = $FLUPC[ 24  50]
SET      Company      = $FLUPC[ 51  79]
SET      Addr1        = $FLUPC[ 80 104]
SET      CityStateZip = $FLUPC[105 135]
;
;   Tidy up fields
;
TRIM     Name         BOTH SPACE
TRIM     Title        BOTH SPACE
TRIM     Company      BOTH SPACE
TRIM     Addr1        BOTH SPACE
CHANGE   Addr1        "  " SPACE
TRIM     CityStateZip BOTH SPACE
;
;   Process
;
CALL     "Deduce Fields"
CALL     "Output"

;==============================================================================
;
;  Subroutines
;
;------------------------------------------------------------------------------

CODE     "Deduce Fields"
   ;
   ;   Initialize
   ;
   SET     NameSalutatn = NULL
   SET     NameFirst    = NULL
   SET     NameMiddle   = NULL
   SET     NameLast     = NULL
   SET     NameSuffix   = NULL
   SET     City         = NULL
   SET     State        = NULL
   SET     Zip          = NULL
   SET     ZipExt       = NULL
   ;
   ;   Remove any noise spaces
   ;
   CHANGE  Name         "  " SPACE
   CHANGE  CityStateZip "  " SPACE

   ;- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
   ;
   ;   Deduce Name Fields
   ;
   CALL    "Get Name Parts"

   ;- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
   ;
   ;   Deduce CityStateZip fields
   ;
   ;
   ;   Look for the Zip
   ;
   TRIM    CityStateZip ALL COMMA
   PARSE   ZipData CityStateZip LASTSPACE LAST
   SETLEN  ZipLen ZipData
   SET     Placed = NO
   SET     TestNum = ZipData[1 5]
   CALL    "Test Numeric"
   BEGIN   TestNumeric = YES
     ;
     ;   Looks like a ZIP code
     ;
     TRIM     ZipData ALL DASH
     EXTRACT  Zip     ZipData "1" "5"
     EXTRACT  Zip4    ZipData "1" "4"
     EXTRACT  ZipExt  ZipData "1" "3"
     SET      Placed  = YES
   ELSE
     ;
     ;   Not a ZIP code
     ;
     ;   Maybe this is a state (i.e. there was no Zip)
     ;
     BEGIN   ZipLen = "2"
       BEGIN   States ^ ZipData
         SET     State  = ZipData
         SET     Placed = YES
       END
     END
   END
   BEGIN   Placed = YES
     PEEL     toss         CityStateZip LASTSPACE LAST
   END
   ;
   ;   Look for State
   ;
   BEGIN   State = NULL
     PEEL     State        CityStateZip LASTSPACE LAST
   END
   ;
   ;   Get City
   ;
   SET     City = CityStateZip
END

;------------------------------------------------------------------------------

CODE     "Get Name Parts"
  SET       ScanVarName  = "Name"
  SET       ScanListName = "SALUTATN"
  SET       ScanNeedPosn = POSNFIRST
  CALL      "Array Scan"
  BEGIN     ScanFrom <> "0"
    ;
    ;   We found a salutation
    ;
    PEEL    NameSalutatn Name FIRST SPACE
  END
  ;
  ;   NameFirst
  ;
  TRIM    Name LEFT SPACE
  PEEL    NameFirst Name FIRST SPACE
  ;
  ;   NameMiddle (actually, it's a middle initial)
  ;
  TRIM     Name LEFT SPACE
  BEGIN    Name[2] = SPACE
    PEEL     NameMiddle Name FIRST SPACE
  END
  ;
  ;   NameLast
  ;
  TRIM     Name LEFT SPACE
  SET      NameLast = Name
  ;
  ;   Name Suffix
  ;
  SET      ScanVarName  = "NameLast"
  SET      ScanListName = "NAMESUFF"
  SET      ScanNeedPosn = POSNLAST
  CALL     "Array Scan"
  BEGIN    ScanFrom <> "0"
    ;
    ;   We found a suffix
    ;
    PEEL     NameSuffix NameLast LASTSPACE LAST
  END
END

;------------------------------------------------------------------------------

CODE     "Output"
  ;
  ;   Output
  ;
  SET      RecNum        = AddrCount
  OUTEND   $LINECOUNTER <> "1" |
  OUTEND                   |RECORD NUMBER:  {RecNum}
  OUT                      |NAME INFO:      [{NameSalutatn}] [{NameFirst}]
  OUTEND                   | [{NameMiddle}] [{NameLast}] [{NameSuffix}]
  OUTEND   Title   <> NULL |TITLE:          {Title}
  OUTEND   Company <> NULL |COMPANY:        {Company}
  OUTEND                   |ADDR1:          {Addr1}
  OUTEND                   |CITY & STATE:   [{City}] [{State}]
  OUTEND                   |ZIP PARTS:      [{Zip}] [{Zip4}] [{ZipExt}]
END

;==============================================================================
;
;   General Parsing Routines
;
;------------------------------------------------------------------------------
;
;   "Array Scan" checks data against the array of scanlists we specify
;
;   Input Variables
;     ScanVarName   The literal name of the variable to scan (e.g. "MyVar")
;     ScanListName  The literal root name of the array (e.g. "MyArray")
;                   The array must start with index 1 (e.g. MyArray,1)
;     ScanNeedPosn  POSNLAST  means "must be found at the end of the item"
;                   POSNFIRST means "must be found in position 1"
;                   POSNANY   means "may be found anywhere"
;
;   Output Variables
;     ScanFrom      First position ("0" if not found)
;     ScanTo        Last  position ("0" if not found)
;
;   Reset Variables
;     ScanLineFrom  Set to NULL
;     ScanLineTo    Set to NULL
;
CODE     "Array Scan"
  ;
  ;   Initialize
  ;
  SET      ScanFrom  = "0"
  SET      ScanTo    = "0"
  SET      scan_specs = ScanNeedPosn
  SETLEN   scanvar_len (@ScanVarName)
  ;
  ;   Loop through lists
  ;
  SET      listnum   = "1"
  SET      searching = YES
  SET      scanfound = NO
  BEGIN
    ;
    ;   Look for it in this list
    ;
    SCANPOSN from to (@ScanVarName) (@ScanListName,@listnum) scan_specs
    ;
    ;   If we found it, see if it scanfound
    ;
    BEGIN    from <> "0"
      BEGIN    ScanNeedPosn = POSNFIRST
        IF       from = "1" THEN scanfound = YES
      END
      BEGIN    ScanNeedPosn = POSNLAST
        IF       to   =  scanvar_len THEN scanfound = YES
      END
      IF       ScanNeedPosn = POSNANY THEN scanfound = YES
    END
    ;
    ;   Test our result
    ;
    BEGIN    scanfound = YES
      ;
      ;   Return the values
      ;
      SET      searching = NO
      SET      ScanFrom  = from
      SET      ScanTo    = to
    ELSE
      SET      listnum = listnum+
      IF       (@ScanListName,@listnum) = NULL THEN searching = NO
    END
  AGAIN    searching = YES
END

;------------------------------------------------------------------------------
;
;   "Test Numeric"  checks if an item is numeric (i.e. only digits)
;
;   Input Variables
;     TestNum         The value to be tested
;
;   Output Variables
;     TestNumeric     Set to YES if numeric, or NO if non-numeric or null
;
CODE     "Test Numeric"
  BEGIN    TestNum = NULL
    SET      TestNumeric = NO
  ELSE
    SET      TestNumeric = YES
    SETLEN   tncounter TestNum
    BEGIN    tncounter <> "0"
      COPY     testdigit TestNum tncounter tncounter
      IF       DIGITS ~ testdigit THEN TestNumeric = NO
      SET      tncounter = tncounter-
    AGAIN    TestNumeric = YES
  END
END